home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / events.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-07  |  48.4 KB  |  1,696 lines
  1. /* Events: printing them, converting them to and from characters.
  2.    Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
  3.  
  4. This file is part of XEmacs.
  5.  
  6. XEmacs is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU General Public License as published by the
  8. Free Software Foundation; either version 2, or (at your option) any
  9. later version.
  10.  
  11. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14. for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with XEmacs; see the file COPYING.  If not, write to the Free
  18. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* Synched up with: Not in FSF. */
  21.  
  22. /* This file has been Mule-ized. */
  23.  
  24. #include <config.h>
  25. #include "lisp.h"
  26. #include "buffer.h"
  27. #include "window.h"
  28. #include "device.h"
  29. #include "device-tty.h" /* for stuff in character_to_event */
  30. #include "device-x.h"    /* for x_event_name prototype */
  31. #include "frame.h"
  32. #include "events.h"
  33. #include "keymap.h"
  34. #include "extents.h"    /* Just for the EXTENTP abort check... */
  35. #include "redisplay.h"
  36.  
  37. /* Where old events go when they are explicitly deallocated.
  38.    The event chain here is cut loose before GC, so these will be freed
  39.    eventually.
  40.  */
  41. static struct Lisp_Event *event_resource;
  42.  
  43. Lisp_Object Qeventp;
  44. Lisp_Object Qevent_live_p;
  45. Lisp_Object Qkey_press_event_p;
  46. Lisp_Object Qbutton_event_p;
  47. Lisp_Object Qmouse_event_p;
  48. Lisp_Object Qprocess_event_p;
  49.  
  50. /* #### Ad-hoc hack.  Should be part of define_lrecord_implementation */
  51. void
  52. clear_event_resource (void)
  53. {
  54.   event_resource = 0;
  55. }
  56.  
  57. static Lisp_Object mark_event (Lisp_Object, void (*) (Lisp_Object));
  58. static void print_event (Lisp_Object, Lisp_Object, int);
  59. static int event_equal (Lisp_Object, Lisp_Object, int);
  60. static unsigned long event_hash (Lisp_Object obj, int depth);
  61. DEFINE_LRECORD_IMPLEMENTATION ("event", event,
  62.                                mark_event, print_event, 0, event_equal,
  63.                    event_hash, struct Lisp_Event);
  64.  
  65. /* Make sure we lose quickly if we try to use this event */
  66. static void
  67. deinitialize_event (struct Lisp_Event *event)
  68. {
  69.   int i;
  70.  
  71.   for (i = 0; i < ((sizeof (struct Lisp_Event)) / sizeof (int)); i++)
  72.     ((int *) event) [i] = 0xdeadbeef;
  73.   event->event_type = dead_event;
  74.   event->device = Qnil;
  75.   set_lheader_implementation (&(event->lheader), lrecord_event);
  76.   event_next (event) = 0;
  77. }
  78.  
  79. static Lisp_Object
  80. mark_event (Lisp_Object obj, void (*markobj) (Lisp_Object))
  81. {
  82.   struct Lisp_Event *event = XEVENT (obj);
  83.  
  84.   switch (event->event_type)
  85.     {
  86.     case key_press_event:
  87.       ((markobj) (event->event.key.keysym));
  88.       break;
  89.     case process_event:
  90.       ((markobj) (event->event.process.process));
  91.       break;
  92.     case timeout_event:
  93.       ((markobj) (event->event.timeout.function));
  94.       ((markobj) (event->event.timeout.object));
  95.       break;
  96.     case eval_event:
  97.     case misc_user_event:
  98.       ((markobj) (event->event.eval.function));
  99.       ((markobj) (event->event.eval.object));
  100.       break;
  101.     case button_press_event:
  102.     case button_release_event:
  103.     case pointer_motion_event:
  104.     case magic_event:
  105.     case empty_event:
  106.     case dead_event:
  107.       break;
  108.     default:
  109.       abort ();
  110.     }
  111.   ((markobj) (event->channel));
  112.   ((markobj) (event->device));
  113.   event = event_next (event);
  114.   if (!event)
  115.     return (Qnil);
  116.   XSETEVENT (obj, event);
  117.   return (obj);
  118. }
  119.  
  120. static void
  121. print_event_1 (CONST char *str, Lisp_Object obj, Lisp_Object printcharfun)
  122. {
  123.   char buf[255];
  124.   write_c_string (str, printcharfun);
  125.   format_event_object (buf, XEVENT (obj), 0);
  126.   write_c_string (buf, printcharfun);
  127. }
  128.  
  129. static void
  130. print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
  131. {
  132.   if (print_readably)
  133.     error ("printing unreadable object #<event>");
  134.  
  135.   switch (XEVENT (obj)->event_type) 
  136.     {
  137.     case key_press_event:
  138.       print_event_1 ("#<keypress-event ", obj, printcharfun);
  139.       break;
  140.     case button_press_event:
  141.       print_event_1 ("#<buttondown-event ", obj, printcharfun);
  142.       break;
  143.     case button_release_event:
  144.       print_event_1 ("#<buttonup-event ", obj, printcharfun);
  145.       break;
  146.     case magic_event:
  147.       print_event_1 ("#<magic-event ", obj, printcharfun);
  148.       break;
  149.     case pointer_motion_event:
  150.       {
  151.     char buf[100];
  152.     sprintf (buf, "#<motion-event %d, %d",
  153.          XEVENT (obj)->event.motion.x, XEVENT (obj)->event.motion.y);
  154.     write_c_string (buf, printcharfun);
  155.     break;
  156.       }
  157.     case process_event:
  158.       {
  159.     write_c_string ("#<process-event ", printcharfun);
  160.     print_internal (XEVENT (obj)->event.process.process, printcharfun, 1);
  161.     break;
  162.       }
  163.     case timeout_event:
  164.       {
  165.     write_c_string ("#<timeout-event ", printcharfun);
  166.     print_internal (XEVENT (obj)->event.timeout.object, printcharfun, 1);
  167.     break;
  168.       }
  169.     case empty_event:
  170.       {
  171.     write_c_string ("#<empty-event", printcharfun);
  172.     break;
  173.       }
  174.     case misc_user_event:
  175.     case eval_event:
  176.       {
  177.     write_c_string ("#<", printcharfun);
  178.     if (XEVENT (obj)->event_type == misc_user_event)
  179.       write_c_string ("misc-user", printcharfun);
  180.     else
  181.       write_c_string ("eval", printcharfun);
  182.     write_c_string ("-event (", printcharfun);
  183.     print_internal (XEVENT (obj)->event.eval.function, printcharfun, 1);
  184.     write_c_string (" ", printcharfun);
  185.     print_internal (XEVENT (obj)->event.eval.object, printcharfun, 1);
  186.     write_c_string (")", printcharfun);
  187.     break;
  188.       }
  189.     case dead_event:
  190.       {
  191.     write_c_string ("#<DEALLOCATED-EVENT", printcharfun);
  192.     break;
  193.       }
  194.     default:
  195.       {
  196.     write_c_string ("#<UNKNOWN-EVENT-TYPE", printcharfun);
  197.     break;
  198.       }
  199.     }
  200.   write_c_string (">", printcharfun);
  201. }
  202.   
  203. static int
  204. event_equal (Lisp_Object o1, Lisp_Object o2, int depth)
  205. {
  206.   struct Lisp_Event *e1 = XEVENT (o1);
  207.   struct Lisp_Event *e2 = XEVENT (o2);
  208.  
  209.   if (e1->event_type != e2->event_type) return 0;
  210.   if (!EQ (e1->channel, e2->channel)) return 0;
  211.   if (!EQ (e1->device, e2->device)) return 0;
  212. /*  if (e1->timestamp != e2->timestamp) return 0; */
  213.   switch (e1->event_type)
  214.     {
  215.     case process_event:
  216.       return (EQ (e1->event.process.process,
  217.           e2->event.process.process));
  218.     
  219.     case timeout_event:
  220.       if (NILP (Fequal (e1->event.timeout.function,
  221.             e2->event.timeout.function)))
  222.     return 0;
  223.       if (NILP (Fequal (e1->event.timeout.object,
  224.             e2->event.timeout.object)))
  225.     return 0;
  226.       return 1;
  227.     
  228.     case key_press_event:
  229.       return ((EQ (e1->event.key.keysym,
  230.                    e2->event.key.keysym)
  231.                && (e1->event.key.modifiers
  232.                    == e2->event.key.modifiers)));
  233.  
  234.     case button_press_event:
  235.     case button_release_event:
  236.       return (((e1->event.button.button
  237.                 == e2->event.button.button)
  238.                && (e1->event.button.modifiers
  239.                    == e2->event.button.modifiers)));
  240.  
  241.     case pointer_motion_event:
  242.       return ((e1->event.motion.x == e2->event.motion.x
  243.                && e1->event.motion.y == e2->event.motion.y));
  244.  
  245.     case misc_user_event:
  246.     case eval_event:
  247.       if (NILP (Fequal (e1->event.eval.function,
  248.             e2->event.eval.function)))
  249.     return 0;
  250.       if (NILP (Fequal (e1->event.eval.object,
  251.             e2->event.eval.object)))
  252.     return 0;
  253.       return 1;
  254.     case magic_event:
  255.       if (!EQ (e1->device, e2->device))
  256.     return 0;
  257.  
  258. #ifdef HAVE_X_WINDOWS
  259.       /* XEvent is actually a union which means that we can't just use == */
  260.       if (DEVICE_IS_X (XDEVICE (e1->device)))
  261.     return (!memcmp ((XEvent *) &e1->event.magic.underlying_x_event,
  262.              (XEvent *) &e2->event.magic.underlying_x_event,
  263.              sizeof (e1->event.magic.underlying_x_event)));
  264. #endif
  265. #ifdef HAVE_NEXTSTEP
  266.       if (DEVICE_IS_NS (XDEVICE (e1->device)))
  267.     return (e1->event.magic.underlying_ns_event ==
  268.         e2->event.magic.underlying_ns_event);
  269. #endif
  270.       return (e1->event.magic.underlying_tty_event ==
  271.           e2->event.magic.underlying_tty_event);
  272.  
  273.     case empty_event:      /* Empty and deallocated events are equal. */
  274.     case dead_event:
  275.       return 1;
  276.  
  277.     default:
  278.       abort ();
  279.       return 0;                 /* not reached; warning suppression */
  280.     }
  281. }
  282.  
  283. static unsigned long
  284. event_hash (Lisp_Object obj, int depth)
  285. {
  286.   struct Lisp_Event *e = XEVENT (obj);
  287.   unsigned long hash;
  288.  
  289.   hash = HASH3 (e->event_type, LISP_HASH (e->channel), LISP_HASH (e->device));
  290.   switch (e->event_type)
  291.     {
  292.     case process_event:
  293.       return HASH2 (hash, LISP_HASH (e->event.process.process));
  294.     
  295.     case timeout_event:
  296.       return HASH3 (hash, internal_hash (e->event.timeout.function, depth + 1),
  297.             internal_hash (e->event.timeout.object, depth + 1));
  298.     
  299.     case key_press_event:
  300.       return HASH3 (hash, LISP_HASH (e->event.key.keysym),
  301.             e->event.key.modifiers);
  302.  
  303.     case button_press_event:
  304.     case button_release_event:
  305.       return HASH3 (hash, e->event.button.button, e->event.button.modifiers);
  306.  
  307.     case pointer_motion_event:
  308.       return HASH3 (hash, e->event.motion.x, e->event.motion.y);
  309.  
  310.     case misc_user_event:
  311.     case eval_event:
  312.       return HASH3 (hash, internal_hash (e->event.eval.function, depth + 1),
  313.             internal_hash (e->event.eval.object, depth + 1));
  314.  
  315.     case magic_event:
  316. #ifdef HAVE_X_WINDOWS
  317.       if (DEVICE_IS_X (XDEVICE (e->device)))
  318.     return
  319.       HASH2 (hash,
  320.          memory_hash (&e->event.magic.underlying_x_event,
  321.                   sizeof (e->event.magic.underlying_x_event)));
  322. #endif
  323. #ifdef HAVE_NEXTSTEP
  324.         if (DEVICE_IS_NS (XDEVICE (e->device)))
  325.            return
  326.          HASH2 (hash,
  327.             memory_hash (&e->event.magic.underlying_ns_event,
  328.                  sizeof (e->event.magic.underlying_ns_event)));
  329. #endif
  330.     return
  331.       HASH2 (hash,
  332.          memory_hash (&e->event.magic.underlying_tty_event,
  333.                   sizeof (e->event.magic.underlying_tty_event)));
  334.  
  335.     case empty_event:
  336.     case dead_event:
  337.       return hash;
  338.  
  339.     default:
  340.       abort ();
  341.     }
  342.  
  343.   return 0;
  344. }
  345.  
  346.  
  347. DEFUN ("allocate-event", Fallocate_event, Sallocate_event, 0, 0, 0,
  348.   "Return an empty event structure.\n\
  349. WARNING, the event object returned may be a reused one; see the function\n\
  350. `deallocate-event'.")
  351.     ()
  352. {
  353.   struct Lisp_Event *e;
  354.   Lisp_Object event;
  355.   if (event_resource)
  356.     {
  357.       e = event_resource;
  358.       event_resource = event_next (e);
  359.       XSETEVENT (event, e);
  360.     }
  361.   else
  362.     {
  363.       event = make_event ();
  364.       e = XEVENT (event);
  365.     }
  366.   deinitialize_event (e);
  367.   e->event_type = empty_event;
  368.   set_event_next (e, 0);
  369.   e->timestamp = 0;
  370.   e->channel = Qnil;
  371.   e->device = Qnil;
  372.   return event;
  373. }
  374.  
  375. DEFUN ("deallocate-event", Fdeallocate_event, Sdeallocate_event, 1, 1, 0,
  376.   "Allow the given event structure to be reused.\n\
  377. You MUST NOT use this event object after calling this function with it.\n\
  378. You will lose.  It is not necessary to call this function, as event\n\
  379. objects are garbage-collected like all other objects; however, it may\n\
  380. be more efficient to explicitly deallocate events when you are sure\n\
  381. that that is safe.")
  382.     (event)
  383.     Lisp_Object event;
  384. {
  385.   struct Lisp_Event *e;
  386.   CHECK_EVENT (event, 0);
  387.  
  388.   e = XEVENT (event);
  389.   if (e->event_type == dead_event)
  390.     error ("this event is already deallocated!");
  391.  
  392.   if (e->event_type > last_event_type)
  393.     abort ();
  394.  
  395. #if 0
  396.   {  
  397.     int i;
  398.     extern Lisp_Object Vlast_command_event;
  399.     extern Lisp_Object Vlast_input_event, Vunread_command_event;
  400.     extern Lisp_Object Vthis_command_keys, Vrecent_keys_ring;
  401.  
  402.     if (EQ (event, Vlast_command_event))
  403.       abort ();
  404.     if (EQ (event, Vlast_input_event))
  405.       abort ();
  406.     if (EQ (event, Vunread_command_event))
  407.       abort ();
  408.     for (i = 0; i < XVECTOR (Vthis_command_keys)->size; i++)
  409.       if (EQ (event, vector_data (XVECTOR (Vthis_command_keys)) [i]))
  410.     abort ();
  411.     for (i = 0; i < XVECTOR (Vrecent_keys_ring)->size; i++)
  412.       if (EQ (event, vector_data (XVECTOR (Vrecent_keys_ring)) [i]))
  413.     abort ();
  414.   }
  415. #endif /* 0 */
  416.  
  417.   if (e == event_resource)
  418.     abort ();
  419.   deinitialize_event (e);
  420. #ifndef ALLOC_NO_POOLS
  421.   set_event_next (e, event_resource);
  422.   event_resource = e;
  423. #endif
  424.   return Qnil;
  425. }
  426.  
  427. DEFUN ("copy-event", Fcopy_event, Scopy_event, 1, 2, 0,
  428.   "Make a copy of the given event object.\n\
  429. If a second argument is given, the first event is copied into the second\n\
  430. and the second is returned.  If the second argument is not supplied (or\n\
  431. is nil) then a new event will be made as with `allocate-event.'  See also\n\
  432. the function `deallocate-event'.")
  433.      (event1, event2)
  434.      Lisp_Object event1, event2;
  435. {
  436.   struct Lisp_Event *e1, *e2;
  437.  
  438.   CHECK_LIVE_EVENT (event1, 0);
  439.   if (NILP (event2))
  440.     event2 = Fallocate_event ();
  441.   else CHECK_LIVE_EVENT (event2, 0);
  442.   if (EQ (event1, event2))
  443.     return signal_simple_continuable_error_2
  444.       ("copy-event called with `eq' events", event1, event2);
  445.   e1 = XEVENT (event1);
  446.   e2 = XEVENT (event2);
  447.  
  448.   if (e1->event_type > last_event_type ||
  449.       e2->event_type > last_event_type)
  450.     abort ();
  451.   {
  452.     struct Lisp_Event *save_next = event_next (e2);
  453.  
  454.     *e2 = *e1;
  455.     set_event_next (e2, save_next);
  456.     return (event2);
  457.   }
  458. }
  459.  
  460.  
  461.  
  462. Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape,
  463.  QKspace, QKdelete, QKnosymbol;
  464.  
  465. int
  466. command_event_p (struct Lisp_Event *event)
  467. {
  468.   switch (event->event_type)
  469.     {
  470.     case key_press_event:
  471.     case button_press_event:
  472.     case button_release_event:
  473.     case misc_user_event:
  474.       return (1);
  475.     default:
  476.       return (0);
  477.     }
  478. }
  479.  
  480.  
  481. void
  482. character_to_event (Emchar c, struct Lisp_Event *event, struct device *d)
  483. {
  484.   Lisp_Object k = Qnil;
  485.   unsigned int m = 0;
  486.   if (event->event_type == dead_event)
  487.     error ("character-to-event called with a deallocated event!");
  488.  
  489. #ifndef MULE
  490.   c &= 255;
  491. #endif
  492.   if (c > 127 && c <= 255)
  493.     {
  494.       int meta_flag = 1;
  495.       if (d && DEVICE_IS_TTY (d))
  496.     meta_flag = TTY_FLAGS (d).meta_key;
  497.       switch (meta_flag)
  498.     {
  499.     case 0: /* ignore top bit; it's parity */
  500.       c -= 128;
  501.       break;
  502.     case 1: /* top bit is meta */
  503.       c -= 128;
  504.       m = MOD_META;
  505.       break;
  506.     default: /* this is a real character */
  507.       break;
  508.     }
  509.     }
  510.   if (c < ' ') c += '@', m |= MOD_CONTROL;
  511.   if (m & MOD_CONTROL)
  512.     {
  513.       switch (c)
  514.     {
  515.     case 'I': k = QKtab;      m &= ~MOD_CONTROL; break;
  516.     case 'J': k = QKlinefeed; m &= ~MOD_CONTROL; break;
  517.     case 'M': k = QKreturn;      m &= ~MOD_CONTROL; break;
  518.     case '[': k = QKescape;      m &= ~MOD_CONTROL; break;
  519. # if 0
  520.       /* This is probably too controversial... */
  521.     case 'H': k = QKbackspace; m &= ~MOD_CONTROL; break;
  522. # endif
  523.     }
  524.       if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
  525.     }
  526.   else if (c == 127) k = QKdelete;
  527.   else if (c == ' ') k = QKspace;
  528.   
  529.   event->event_type        = key_press_event;
  530.   event->channel        = Qnil;
  531.   event->timestamp        = 0;
  532.   if (d)
  533.     XSETDEVICE (event->device, d);
  534.   else
  535.     event->device = Fselected_device ();
  536.   event->event.key.keysym    = (!NILP (k) ? k : make_number (c));
  537.   event->event.key.modifiers    = m;
  538. }
  539.  
  540.  
  541. /* This variable controls what character name -> character code mapping
  542.    we are using.  Window-system-specific code sets this to some symbol,
  543.    and we use that symbol as the plist key to convert keysyms into 8-bit
  544.    codes.  In this way one can have several character sets predefined and
  545.    switch them by changing this.
  546.  */
  547. Lisp_Object Vcharacter_set_property;
  548.  
  549. Emchar
  550. event_to_character (struct Lisp_Event *event,
  551.             int allow_extra_modifiers,
  552.             int allow_meta,
  553.             int allow_non_ascii)
  554. {
  555.   Emchar c = 0;
  556.   if (event->event_type != key_press_event)
  557.     {
  558.       if (event->event_type == dead_event) abort ();
  559.       return -1;
  560.     }
  561.   if (!allow_extra_modifiers &&
  562.       event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT))
  563.     return -1;
  564.   if (INTP (event->event.key.keysym))   c = XINT (event->event.key.keysym);
  565.   else if (EQ (event->event.key.keysym, QKbackspace))    c = '\b';
  566.   else if (EQ (event->event.key.keysym, QKtab))        c = '\t';
  567.   else if (EQ (event->event.key.keysym, QKlinefeed))    c = '\n';
  568.   else if (EQ (event->event.key.keysym, QKreturn))    c = '\r';
  569.   else if (EQ (event->event.key.keysym, QKescape))    c = 27;
  570.   else if (EQ (event->event.key.keysym, QKspace))    c = ' ';
  571.   else if (EQ (event->event.key.keysym, QKdelete))    c = 127;
  572.  
  573.   else if (!SYMBOLP (event->event.key.keysym))
  574.     abort ();
  575.   else if (allow_non_ascii && !NILP (Vcharacter_set_property))
  576.     {
  577.       /* Allow window-system-specific extensibility of keysym->code mapping */
  578.       Lisp_Object code = Fget (event->event.key.keysym,
  579.                                Vcharacter_set_property,
  580.                    Qnil);
  581.       if (!INTP (code))
  582.     return -1;
  583.       c = XINT (code);
  584.     }
  585.   else
  586.     return -1;
  587.  
  588.   if (event->event.key.modifiers & MOD_CONTROL)
  589.     {
  590.       if (c >= 'a' && c <= 'z')
  591.     c -= ('a' - 'A');
  592.       else
  593.     /* reject Control-Shift- keys */
  594.     if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers)
  595.       return -1;
  596.       
  597.       if (c >= '@' && c <= '_')
  598.     c -= '@';
  599.       else if (c == ' ')  /* C-space and C-@ are the same. */
  600.     c = 0;
  601.       else
  602.     /* reject keys that can't take Control- modifiers */
  603.     if (! allow_extra_modifiers) return -1;
  604.     }
  605.  
  606.   if (event->event.key.modifiers & MOD_META)
  607.     {
  608.       if (! allow_meta) return -1;
  609.       if (c & 0200) return -1;        /* don't allow M-oslash (overlap) */
  610. #ifdef MULE
  611.       if (c >= 256) return -1;
  612. #endif
  613.       c |= 0200;
  614.     }
  615.   return c;
  616. }
  617.  
  618.  
  619. DEFUN ("event-to-character", Fevent_to_character, Sevent_to_character,
  620.        1, 4, 0,
  621.  "Return the closest ASCII approximation to the given event object.\n\
  622. If the event isn't a keypress, this returns nil.\n\
  623. If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in\n\
  624.  its translation; it will ignore modifier keys other than control and meta,\n\
  625.  and will ignore the shift modifier on those characters which have no\n\
  626.  shifted ASCII equivalent (Control-Shift-A for example, will be mapped to\n\
  627.  the same ASCII code as Control-A).\n\
  628. If the ALLOW-META argument is non-nil, then the Meta modifier will be\n\
  629.  represented by turning on the high bit of the byte returned; otherwise, nil\n\
  630.  will be returned for events containing the Meta modifier.\n\
  631. If the ALLOW-NON-ASCII argument is non-nil, then characters which are\n\
  632.  present in the prevailing character set (see the `character-set-property'\n\
  633.  variable) will be returned as their code in that character set, instead of\n\
  634.  the return value being restricted to ASCII.\n\
  635. Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as\n\
  636.  both use the high bit; `M-x' and `oslash' will be indistinguishable.")
  637.      (event, allow_extra_modifiers, allow_meta, allow_non_ascii)
  638.      Lisp_Object event, allow_extra_modifiers, allow_meta, allow_non_ascii;
  639. {
  640.   Emchar c;
  641.   CHECK_LIVE_EVENT (event, 0);
  642.   c = event_to_character (XEVENT (event),
  643.               !NILP (allow_extra_modifiers),
  644.               !NILP (allow_meta),
  645.               !NILP (allow_non_ascii));
  646.   return (c < 0 ? Qnil : make_number (c));
  647. }
  648.  
  649.  
  650. DEFUN ("character-to-event", Fcharacter_to_event, Scharacter_to_event, 1, 3, 0,
  651.   "Converts a numeric ASCII value to an event structure, replete with\n\
  652. bucky bits.  The character is the first argument, and the event to fill\n\
  653. in is the second.  This function contains knowledge about what the codes\n\
  654. ``mean'' -- for example, the number 9 is converted to the character ``Tab'',\n\
  655. not the distinct character ``Control-I''.\n\
  656. \n\
  657. Note that CH does not have to be a numeric value, but can be a symbol such\n\
  658.  as 'clear or a list such as '(control backspace).\n\
  659. \n\
  660. If the optional second argument is an event, it is modified; otherwise, a\n\
  661.  new event object is created.\n\
  662. \n\
  663. Optional third arg DEVICE is the device to store in the event; this also\n\
  664.  affects whether the high bit is interpreted as a meta key.  A value of nil\n\
  665.  means use the selected device but always treat the high bit as meta.\n\
  666. \n\
  667. Beware that character-to-event and event-to-character are not strictly\n\
  668.  inverse functions, since events contain much more information than the\n\
  669.  ASCII character set can encode.")
  670.      (ch, event, device)
  671.      Lisp_Object ch, event, device;
  672. {
  673.   struct device *d;
  674.  
  675.   if (EQ (device, Qnil))
  676.     d = 0;
  677.   else
  678.     d = get_device (device);
  679.   if (NILP (event))
  680.     event = Fallocate_event ();
  681.   else
  682.     CHECK_LIVE_EVENT (event, 0);
  683.   if (CHARP (ch))
  684.     character_to_event (XINT (ch), XEVENT (event), d);
  685.   else if (CONSP (ch) || SYMBOLP (ch))
  686.     key_desc_list_to_event (ch, event, 1);
  687.   else
  688.     CHECK_INT (ch, 0);
  689.   return event;
  690. }
  691.  
  692. void
  693. format_event_object (char *buf, struct Lisp_Event *event, int brief)
  694. {
  695.   int mouse_p = 0;
  696.   int mod = 0;
  697.   Lisp_Object key;
  698.  
  699.   switch (event->event_type)
  700.     {
  701.     case key_press_event:
  702.       {
  703.         mod = event->event.key.modifiers;
  704.         key = event->event.key.keysym;
  705.         /* Hack. */
  706.         if (! brief && INTP (key) &&
  707.             mod & (MOD_CONTROL|MOD_META|MOD_SUPER|MOD_HYPER))
  708.     {
  709.       int k = XINT (key);
  710.       if (k >= 'a' && k <= 'z')
  711.         key = make_number (k - ('a'-'A'));
  712.       else if (k >= 'A' && k <= 'Z')
  713.         mod |= MOD_SHIFT;
  714.     }
  715.         break;
  716.       }
  717.     case button_release_event:
  718.       mouse_p++;
  719.       /* Fall through */
  720.     case button_press_event:
  721.       {
  722.         mouse_p++;
  723.         mod = event->event.button.modifiers;
  724.         key = make_number (event->event.button.button + '0');
  725.         break;
  726.       }
  727.     case magic_event:
  728.       {
  729.         CONST char *name = 0;
  730.  
  731. #ifdef HAVE_X_WINDOWS
  732.         if (DEVICE_IS_X (XDEVICE (Vselected_device)))
  733.       name =
  734.         x_event_name (event->event.magic.underlying_x_event.xany.type);
  735. #endif
  736. #ifdef HAVE_NEXTSTEP
  737.         if (DEVICE_IS_NS (XDEVICE (Vselected_device)))
  738.       name = ns_event_name (event->event.magic.underlying_ns_event);
  739. #endif
  740.     if (name) strcpy (buf, name);
  741.     else strcpy (buf, "???");
  742.     return;
  743.       }
  744.     case pointer_motion_event:    strcpy (buf, "motion");    return;
  745.     case misc_user_event:    strcpy (buf, "misc-user"); return;
  746.     case eval_event:        strcpy (buf, "eval");     return;
  747.     case process_event:        strcpy (buf, "process");return;
  748.     case timeout_event:        strcpy (buf, "timeout");return;
  749.     case empty_event:        strcpy (buf, "EMPTY-EVENT"); return;
  750.     case dead_event:        strcpy (buf, "DEAD-EVENT");  return;
  751.     default:
  752.       abort ();
  753.     }
  754. #define modprint1(x)  { strcpy (buf, (x)); buf += sizeof (x)-1; }
  755. #define modprint(x,y) { if (brief) modprint1 (y) else modprint1 (x) }
  756.   if (mod & MOD_CONTROL) modprint ("control-", "C-");
  757.   if (mod & MOD_META)    modprint ("meta-",    "M-");
  758.   if (mod & MOD_SUPER)   modprint ("super-",   "S-");
  759.   if (mod & MOD_HYPER)   modprint ("hyper-",   "H-");
  760.   if (mod & MOD_ALT)     modprint ("alt-",     "A-");
  761.   if (mod & MOD_SHIFT)   modprint ("shift-",   "Sh-");
  762.   if (mouse_p)
  763.     {
  764.       modprint1 ("button");
  765.       --mouse_p;
  766.     }
  767. #undef modprint
  768. #undef modprint1
  769.  
  770.   if (INTP (key))
  771.     {
  772.       Bytecount len = emchar_to_charptr (XINT (key), (Bufbyte *) buf);
  773.       buf[len] = 0;
  774.       buf += len;
  775.     }
  776.   else if (SYMBOLP (key))
  777.     {
  778.       CONST char *str = 0;
  779.       if (brief)
  780.     {
  781.       if (EQ (key, QKlinefeed)) str = "LFD";
  782.       else if (EQ (key, QKtab)) str = "TAB";
  783.       else if (EQ (key, QKreturn)) str = "RET";
  784.       else if (EQ (key, QKescape)) str = "ESC";
  785.       else if (EQ (key, QKdelete)) str = "DEL";
  786.       else if (EQ (key, QKspace)) str = "SPC";
  787.       else if (EQ (key, QKbackspace)) str = "BS";
  788.     }
  789.       if (str)
  790.     {
  791.       int i = strlen (str);
  792.       memcpy (buf, str, i+1);
  793.       str += i;
  794.     }
  795.       else
  796.     {
  797.       memcpy (buf, string_data (XSYMBOL (key)->name),
  798.                 string_length (XSYMBOL (key)->name) + 1);
  799.       str += string_length (XSYMBOL (key)->name);
  800.     }
  801.     }
  802.   else
  803.     abort ();
  804.   if (mouse_p)
  805.     strncpy (buf, "up", 4);
  806. }
  807.  
  808. DEFUN ("eventp", Feventp, Seventp, 1, 1, 0,
  809.        "True if OBJECT is an event object.")
  810.      (object)
  811.      Lisp_Object object;
  812. {
  813.   return ((EVENTP (object)) ? Qt : Qnil);
  814. }
  815.  
  816. DEFUN ("event-live-p", Fevent_live_p, Sevent_live_p, 1, 1, 0,
  817.   "True if OBJECT is an event object that has not been deallocated.")
  818.      (object)
  819.      Lisp_Object object;
  820. {
  821.   return ((EVENTP (object) && XEVENT (object)->event_type != dead_event)
  822.       ? Qt : Qnil);
  823. }
  824.  
  825. /* DEFUN ("event-next", Fevent_next, Sevent_next, 1, 1, 0,
  826.  *   "Return the event object's `next' event, or nil if it has none.\n\
  827.  * The `next-event' field is changed by calling `set-next-event'.")
  828.  *      (event)
  829.  *      Lisp_Object event;
  830.  * {
  831.  *   struct Lisp_Event *e;
  832.  *   CHECK_LIVE_EVENT (event, 0);
  833.  * 
  834.  *   e = event_next (XEVENT (event));
  835.  *   if (!e)
  836.  *     return Qnil;
  837.  *   XSETEVENT (event, e);
  838.  *   return (event);
  839.  * }
  840.  * 
  841.  * DEFUN ("set-event-next", Fset_event_next, Sset_event_next, 2, 2, 0,
  842.  *   "Set the `next event' of EVENT to NEXT-EVENT.\n\
  843.  * NEXT-EVENT must be an event object or nil.")
  844.  *      (event, next_event)
  845.  *      Lisp_Object event, next_event;
  846.  * {
  847.  *   struct Lisp_Event *e;
  848.  * 
  849.  *   CHECK_LIVE_EVENT (event, 0);
  850.  *   if (NILP (next_event))
  851.  *     {
  852.  *       event_next (XEVENT (event)) = 0;
  853.  *       return (Qnil);
  854.  *     }
  855.  * 
  856.  *   CHECK_LIVE_EVENT (next_event, 1);
  857.  *   for (e = XEVENT (next_event); e; e = event_next (e))
  858.  *     {
  859.  *       QUIT;
  860.  *       if (e == XEVENT (event))
  861.  *     signal_error (Qerror, 
  862.  *               list3 (build_string ("Cyclic event-next"),
  863.  *                  event, 
  864.  *                  next_event));
  865.  *     }
  866.  *   event_next (XEVENT (event)) = XEVENT (next_event);
  867.  *   return (next_event);
  868.  * }
  869.  */
  870.  
  871.  
  872. #define EVENT_PRED(type) \
  873.   return ((EVENTP (obj) && XEVENT (obj)->event_type == (type)) \
  874.       ? Qt : Qnil)
  875.  
  876. DEFUN ("key-press-event-p", Fkey_press_event_p, Skey_press_event_p, 1, 1, 0,
  877.        "True if the argument is a key-press event object.")
  878.      (obj)
  879.      Lisp_Object obj;
  880. {
  881.   EVENT_PRED (key_press_event);
  882. }
  883.  
  884. DEFUN ("button-press-event-p", Fbutton_press_event_p, Sbutton_press_event_p,
  885.        1, 1, 0, "True if the argument is a mouse-button-press event object.")
  886.      (obj)
  887.      Lisp_Object obj;
  888. {
  889.   EVENT_PRED (button_press_event);
  890. }
  891.  
  892. DEFUN ("button-release-event-p", Fbutton_release_event_p,
  893.        Sbutton_release_event_p, 1, 1, 0,
  894.        "True if the argument is a mouse-button-release event object.")
  895.      (obj)
  896.      Lisp_Object obj;
  897. {
  898.   if (EVENTP (obj) && XEVENT (obj)->event_type == button_release_event)
  899.     return Qt;
  900.   else
  901.     return Qnil;
  902. }  
  903. /* { EVENT_PRED (button_release_event); } */
  904.  
  905. DEFUN ("button-event-p", Fbutton_event_p,
  906.        Sbutton_event_p, 1, 1, 0,
  907.        "True if the argument is a button-press or button-release event object.")
  908.      (obj)
  909.      Lisp_Object obj;
  910. {
  911.   return ((EVENTP (obj)
  912.        && (XEVENT (obj)->event_type == button_press_event ||
  913.            XEVENT (obj)->event_type == button_release_event))
  914.       ? Qt : Qnil);
  915. }
  916.  
  917. DEFUN ("motion-event-p", Fmotion_event_p, Smotion_event_p, 1, 1, 0,
  918.        "True if the argument is a mouse-motion event object.")
  919.      (obj)
  920.      Lisp_Object obj;
  921. {
  922.   EVENT_PRED (pointer_motion_event);
  923. }
  924.  
  925. DEFUN ("process-event-p", Fprocess_event_p, Sprocess_event_p, 1, 1, 0,
  926.        "True if the argument is a process-output event object.")
  927.      (obj)
  928.      Lisp_Object obj;
  929. {
  930.   EVENT_PRED (process_event);
  931. }
  932.  
  933. DEFUN ("timeout-event-p", Ftimeout_event_p, Stimeout_event_p, 1, 1, 0,
  934.        "True if the argument is a timeout event object.")
  935.      (obj)
  936.      Lisp_Object obj;
  937. {
  938.   EVENT_PRED (timeout_event);
  939. }
  940.  
  941. DEFUN ("misc-user-event-p", Fmisc_user_event_p, Smisc_user_event_p, 1, 1, 0,
  942.        "True if the argument is a misc-user event object.\n\
  943. A misc-user event is a user event that is not a keypress or mouse click;\n\
  944. normally this means a menu selection or scrollbar action.")
  945.      (obj)
  946.      Lisp_Object obj;
  947. {
  948.   EVENT_PRED (misc_user_event);
  949. }
  950.  
  951. DEFUN ("eval-event-p", Feval_event_p, Seval_event_p, 1, 1, 0,
  952.        "True if the argument is an `eval' event object.")
  953.      (obj)
  954.      Lisp_Object obj;
  955. {
  956.   EVENT_PRED (eval_event);
  957. }
  958.  
  959. DEFUN ("event-timestamp", Fevent_timestamp, Sevent_timestamp, 1, 1, 0,
  960.   "Return the timestamp of the given event object.")
  961.      (event)
  962.   Lisp_Object event;
  963. {
  964.   CHECK_LIVE_EVENT (event, 0);
  965.   /* This junk is so that timestamps don't get to be negative, but contain
  966.      as many bits as this particular emacs will allow.
  967.    */
  968.   return make_number (((1L << (VALBITS - 1)) - 1) &
  969.               XEVENT (event)->timestamp);
  970. }
  971.  
  972. #define CHECK_EVENT_TYPE(e,t1,sym)        \
  973. { CHECK_LIVE_EVENT (e, 0);            \
  974.   if (XEVENT(e)->event_type != (t1))        \
  975.      e = wrong_type_argument ((sym),(e));    \
  976. }
  977.  
  978. #define CHECK_EVENT_TYPE2(e,t1,t2,sym)                    \
  979. { CHECK_LIVE_EVENT (e, 0);                        \
  980.   if (XEVENT(e)->event_type != (t1) && XEVENT(e)->event_type != (t2))    \
  981.      e = wrong_type_argument ((sym),(e));                \
  982. }
  983.  
  984. DEFUN ("event-key", Fevent_key, Sevent_key, 1, 1, 0,
  985.        "Return the KeySym of the given key-press event.  This will be the\n\
  986. ASCII code of a printing character, or a symbol.")
  987.      (event)
  988.   Lisp_Object event;
  989. {
  990.   CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
  991.   return (XEVENT (event)->event.key.keysym);
  992. }
  993.  
  994. /* #### This is X only but we need to redo some lisp code to get rid of it */
  995.  
  996. DEFUN ("event-button", Fevent_button, Sevent_button, 1, 1, 0,
  997.        "Return the button-number of the given mouse-button-press event.")
  998.      (event)
  999.   Lisp_Object event;
  1000. {
  1001.   CHECK_EVENT_TYPE2 (event, button_press_event, button_release_event,
  1002.              Qbutton_event_p);
  1003. #ifdef HAVE_WINDOW_SYSTEM
  1004.   return make_number (XEVENT (event)->event.button.button);
  1005. #else /* !HAVE_WINDOW_SYSTEM */
  1006.   return Qzero;
  1007. #endif /* !HAVE_WINDOW_SYSTEM */
  1008. }
  1009.  
  1010. DEFUN ("event-modifier-bits", Fevent_modifier_bits, Sevent_modifier_bits,
  1011.        1, 1, 0,
  1012.        "Return a number representing the modifier keys which were down\n\
  1013. when the given mouse or keyboard event was produced.  See also the function\n\
  1014. event-modifiers.")
  1015.      (event)
  1016.   Lisp_Object event;
  1017. {
  1018.  again:
  1019.   CHECK_LIVE_EVENT (event, 0);
  1020.   if (XEVENT (event)->event_type == key_press_event)
  1021.     return make_number (XEVENT (event)->event.key.modifiers);
  1022.   else if (XEVENT (event)->event_type == button_press_event ||
  1023.        XEVENT (event)->event_type == button_release_event)
  1024.     return make_number (XEVENT (event)->event.button.modifiers);
  1025.   else if (XEVENT (event)->event_type == pointer_motion_event)
  1026.     return make_number (XEVENT (event)->event.motion.modifiers);
  1027.   else
  1028.     {
  1029.       event = wrong_type_argument (intern ("key-or-mouse-event-p"), event);
  1030.       goto again;
  1031.     }
  1032. }
  1033.  
  1034. DEFUN ("event-modifiers", Fevent_modifiers, Sevent_modifiers, 1, 1, 0,
  1035.        "Return a list of symbols, the names of the modifier keys\n\
  1036. which were down when the given mouse or keyboard event was produced.\n\
  1037. See also the function event-modifier-bits.")
  1038.      (event)
  1039.   Lisp_Object event;
  1040. {
  1041.   int mod = XINT (Fevent_modifier_bits (event));
  1042.   Lisp_Object result = Qnil;
  1043.   if (mod & MOD_SHIFT)   result = Fcons (Qshift, result);
  1044.   if (mod & MOD_ALT)     result = Fcons (Qalt, result);
  1045.   if (mod & MOD_HYPER)   result = Fcons (Qhyper, result);
  1046.   if (mod & MOD_SUPER)   result = Fcons (Qsuper, result);
  1047.   if (mod & MOD_META)    result = Fcons (Qmeta, result);
  1048.   if (mod & MOD_CONTROL) result = Fcons (Qcontrol, result);
  1049.   return result;
  1050. }
  1051.  
  1052. static int
  1053. event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
  1054. {
  1055.   struct window *w;
  1056.   struct frame *f;
  1057.  
  1058.   if (XEVENT (event)->event_type == pointer_motion_event)
  1059.     {
  1060.       *x = XEVENT (event)->event.motion.x;
  1061.       *y = XEVENT (event)->event.motion.y;
  1062.     }
  1063.   else if (XEVENT (event)->event_type == button_press_event ||
  1064.        XEVENT (event)->event_type == button_release_event)
  1065.     {
  1066.       *x = XEVENT (event)->event.button.x;
  1067.       *y = XEVENT (event)->event.button.y;
  1068.     }
  1069.   else
  1070.     return 0;
  1071.  
  1072.   f = XFRAME (Fevent_frame (event));
  1073.  
  1074.   if (relative)
  1075.     {
  1076.       w = find_window_by_pixel_pos (*x, *y, f->root_window);
  1077.  
  1078.       if (!w)
  1079.     return 1;    /* #### What should really happen here. */
  1080.  
  1081.       *x -= w->pixel_left;
  1082.       *y -= w->pixel_top;
  1083.     }
  1084.   else
  1085.     {
  1086.       *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f);
  1087.       *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f);
  1088.     }
  1089.  
  1090.   return 1;
  1091. }
  1092.  
  1093. DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, Sevent_window_x_pixel,
  1094.        1, 1, 0,
  1095.  "Return the X position in pixels of the given mouse event.\n\
  1096. The value returned is relative to the window the event occurred in.\n\
  1097. This will signal an error if the event is not a mouse-motion, button-press,\n\
  1098. or button-release event.  See also `event-x-pixel'.")
  1099.      (event)
  1100.      Lisp_Object event;
  1101. {
  1102.   int x, y;
  1103.  
  1104.   CHECK_LIVE_EVENT (event, 0);
  1105.  
  1106.   if (!event_x_y_pixel_internal (event, &x, &y, 1))
  1107.     return wrong_type_argument (Qmouse_event_p, event);
  1108.   else
  1109.     return make_number (x);
  1110. }
  1111.  
  1112. DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, Sevent_window_y_pixel,
  1113.        1, 1, 0,
  1114.  "Return the Y position in pixels of the given mouse event.\n\
  1115. The value returned is relative to the window the event occurred in.\n\
  1116. This will signal an error if the event is not a mouse-motion, button-press,\n\
  1117. or button-release event.  See also `event-y-pixel'.")
  1118.      (event)
  1119.      Lisp_Object event;
  1120. {
  1121.   int x, y;
  1122.  
  1123.   CHECK_LIVE_EVENT (event, 0);
  1124.  
  1125.   if (!event_x_y_pixel_internal (event, &x, &y, 1))
  1126.     return wrong_type_argument (Qmouse_event_p, event);
  1127.   else
  1128.     return make_number (y);
  1129. }
  1130.  
  1131. DEFUN ("event-x-pixel", Fevent_x_pixel, Sevent_x_pixel,
  1132.        1, 1, 0,
  1133.  "Return the X position in pixels of the given mouse event.\n\
  1134. The value returned is relative to the frame the event occurred in.\n\
  1135. This will signal an error if the event is not a mouse-motion, button-press,\n\
  1136. or button-release event.  See also `event-window-x-pixel'.")
  1137.      (event)
  1138.      Lisp_Object event;
  1139. {
  1140.   int x, y;
  1141.  
  1142.   CHECK_LIVE_EVENT (event, 0);
  1143.  
  1144.   if (!event_x_y_pixel_internal (event, &x, &y, 0))
  1145.     return wrong_type_argument (Qmouse_event_p, event);
  1146.   else
  1147.     return make_number (x);
  1148. }
  1149.  
  1150. DEFUN ("event-y-pixel", Fevent_y_pixel, Sevent_y_pixel,
  1151.        1, 1, 0,
  1152.  "Return the Y position in pixels of the given mouse event.\n\
  1153. The value returned is relative to the frame the event occurred in.\n\
  1154. This will signal an error if the event is not a mouse-motion, button-press,\n\
  1155. or button-release event.  See also `event-window-y-pixel'.")
  1156.      (event)
  1157.      Lisp_Object event;
  1158. {
  1159.   int x, y;
  1160.  
  1161.   CHECK_LIVE_EVENT (event, 0);
  1162.  
  1163.   if (!event_x_y_pixel_internal (event, &x, &y, 0))
  1164.     return wrong_type_argument (Qmouse_event_p, event);
  1165.   else
  1166.     return make_number (y);
  1167. }
  1168.  
  1169. static int
  1170. event_pixel_translation (Lisp_Object event, int *char_x, int *char_y,
  1171.              int *obj_x, int *obj_y,
  1172.              struct window **w, Bytind *bufp, Bytind *closest,
  1173.              Lisp_Object *obj)
  1174. {
  1175.   int pix_x = 0;
  1176.   int pix_y = 0;
  1177.   int result;
  1178.   Lisp_Object frame;
  1179.  
  1180.   int ret_x, ret_y, ret_obj_x, ret_obj_y;
  1181.   struct window *ret_w;
  1182.   Bytind ret_bufp, ret_closest;
  1183.   Lisp_Object ret_obj;
  1184.   
  1185.   CHECK_LIVE_EVENT (event, 0);
  1186.   if (XEVENT (event)->event_type == pointer_motion_event)
  1187.     {
  1188.       pix_x = XEVENT (event)->event.motion.x;
  1189.       pix_y = XEVENT (event)->event.motion.y;
  1190.       frame = XEVENT (event)->channel;
  1191.     }
  1192.   else if (XEVENT (event)->event_type == button_press_event ||
  1193.        XEVENT (event)->event_type == button_release_event)
  1194.     {
  1195.       pix_x = XEVENT (event)->event.button.x;
  1196.       pix_y = XEVENT (event)->event.button.y;
  1197.       frame = XEVENT (event)->channel;
  1198.     }
  1199.   else
  1200.     wrong_type_argument (Qmouse_event_p, event);
  1201.  
  1202.   result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y,
  1203.                        &ret_x, &ret_y, &ret_obj_x, &ret_obj_y,
  1204.                        &ret_w, &ret_bufp, &ret_closest,
  1205.                        &ret_obj);
  1206.  
  1207.   /* pixel_to_glyph_translation returns the following values:
  1208.  
  1209.      OVER_TOOLBAR:    over one of the 4 frame toolbars
  1210.      OVER_MODELINE:    over a modeline
  1211.      OVER_BORDER:    over an internal border
  1212.      OVER_NOTHING:    over the text area, but not over text
  1213.      OVER_OUTSIDE:    outside of the frame border
  1214.      OVER_TEXT:        over text in the text area
  1215.      */
  1216.  
  1217.   if (result == OVER_NOTHING || result == OVER_OUTSIDE)
  1218.     ret_bufp = 0;
  1219.   else if (ret_w && NILP (ret_w->buffer))
  1220.     /* Why does this happen?  (Does it still happen?)
  1221.        I guess the window has gotten reused as a non-leaf... */
  1222.     ret_w = 0;
  1223.  
  1224.   /* #### pixel_to_glyph_translation() sometimes returns garbage...
  1225.      The word has type Lisp_Record (presumably meaning `extent') but the
  1226.      pointer points to random memory, often filled with 0, sometimes not.
  1227.    */
  1228.   if (!NILP (ret_obj) && !(EXTENTP (ret_obj) || TOOLBAR_BUTTONP (ret_obj)))
  1229.     abort ();
  1230.  
  1231.   if (char_x)
  1232.     *char_x = ret_x;
  1233.   if (char_y)
  1234.     *char_y = ret_y;
  1235.   if (obj_x)
  1236.     *obj_x = ret_obj_x;
  1237.   if (obj_y)
  1238.     *obj_y = ret_obj_y;
  1239.   if (w)
  1240.     *w = ret_w;
  1241.   if (bufp)
  1242.     *bufp = ret_bufp;
  1243.   if (closest)
  1244.     *closest = ret_closest;
  1245.   if (obj)
  1246.     *obj = ret_obj;
  1247.  
  1248.   return result;
  1249. }
  1250.  
  1251. DEFUN ("event-over-text-area-p", Fevent_over_text_area_p,
  1252.        Sevent_over_text_area_p, 1, 1, 0,
  1253.   "Given a mouse-motion, button-press, or button-release event, return\n\
  1254. t if the event is over the text area of a window.  Otherwise, return\n\
  1255. nil.  The modeline is not considered to be part of the text area.")
  1256.      (event)
  1257.      Lisp_Object event;
  1258. {
  1259.   int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0);
  1260.  
  1261.   if (result == OVER_TEXT || result == OVER_NOTHING)
  1262.     return Qt;
  1263.   else
  1264.     return Qnil;
  1265. }
  1266.  
  1267. DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, Sevent_over_modeline_p,
  1268.        1, 1, 0,
  1269.   "Given a mouse-motion, button-press, or button-release event, return\n\
  1270. t if the event is over the modeline of a window.  Otherwise, return nil.")
  1271.      (event)
  1272.      Lisp_Object event;
  1273. {
  1274.   int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0);
  1275.  
  1276.   if (result == OVER_MODELINE)
  1277.     return Qt;
  1278.   else
  1279.     return Qnil;
  1280. }
  1281.  
  1282. DEFUN ("event-over-border-p", Fevent_over_border_p, Sevent_over_border_p,
  1283.        1, 1, 0,
  1284.   "Given a mouse-motion, button-press, or button-release event, return\n\
  1285. t if the event is over an internal border.  Otherwise, return nil.")
  1286.      (event)
  1287.      Lisp_Object event;
  1288. {
  1289.   int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0);
  1290.  
  1291.   if (result == OVER_BORDER)
  1292.     return Qt;
  1293.   else
  1294.     return Qnil;
  1295. }
  1296.  
  1297. DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, Sevent_over_toolbar_p,
  1298.        1, 1, 0,
  1299.   "Given a mouse-motion, button-press, or button-release event, return\n\
  1300. t if the event is over a toolbar.  Otherwise, return nil.")
  1301.      (event)
  1302.      Lisp_Object event;
  1303. {
  1304.   int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0);
  1305.  
  1306.   if (result == OVER_TOOLBAR)
  1307.     return Qt;
  1308.   else
  1309.     return Qnil;
  1310. }
  1311.  
  1312. DEFUN ("event-device", Fevent_device, Sevent_device, 1, 1, 0,
  1313.  "Return the device that the given event occurred on.\n\
  1314. This will be nil for some types of events (e.g. eval events).")
  1315.      (event)
  1316.      Lisp_Object event;
  1317. {
  1318.   CHECK_LIVE_EVENT (event, 0);
  1319.   return EVENT_DEVICE (XEVENT (event));
  1320. }
  1321.  
  1322. /* It would be possible to just use (window-frame (event-window event))
  1323.    but this gives better encapsulation and often makes the code easier
  1324.    to understand. */
  1325. DEFUN ("event-frame", Fevent_frame, Sevent_frame, 1, 1, 0,
  1326.  "Given a mouse-motion, button-press, or button-release event, return\n\
  1327. the frame on which that event occurred.  This will be nil for non-mouse\n\
  1328. events.")
  1329.      (event)
  1330.      Lisp_Object event;
  1331. {
  1332.   CHECK_LIVE_EVENT (event, 0);
  1333.   if (FRAMEP (XEVENT (event)->channel))
  1334.     return (XEVENT (event)->channel);
  1335.   else
  1336.     return Qnil;
  1337. }
  1338.  
  1339. DEFUN ("event-window", Fevent_window, Sevent_window, 1, 1, 0,
  1340.  "Given a mouse motion, button press, or button release event, compute\n\
  1341. and return the window on which that event occurred.  This may be nil if\n\
  1342. the event occurred in the border or over a toolbar.  The modeline is\n\
  1343. considered to be in the window it represents.")
  1344.      (event)
  1345.      Lisp_Object event;
  1346. {
  1347.   struct window *w;
  1348.   Lisp_Object window;
  1349.  
  1350.   event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0);
  1351.  
  1352.   if (!w)
  1353.     return Qnil;
  1354.   else
  1355.     {
  1356.       XSETWINDOW (window, w);
  1357.       return window;
  1358.     }
  1359. }
  1360.  
  1361. /* It would be possible to just use (window-buffer (event-window event))
  1362.    but this gives better encapsulation and often makes the code easier
  1363.    to understand. */
  1364. DEFUN ("event-buffer", Fevent_buffer, Sevent_buffer, 1, 1, 0,
  1365.  "Given a mouse-motion, button-press, or button-release event, return\n\
  1366. the buffer on which that event occurred.  This will be nil for non-mouse\n\
  1367. events.  If event-over-text-area-p is nil, this will also be nil.")
  1368.      (event)
  1369.      Lisp_Object event;
  1370. {
  1371.   Lisp_Object window = Fevent_window (event);
  1372.  
  1373.   if (WINDOWP (window))
  1374.     return XWINDOW (window)->buffer;
  1375.   else
  1376.     return Qnil;
  1377. }
  1378.  
  1379. DEFUN ("event-point", Fevent_point, Sevent_point, 1, 1, 0,
  1380.  "Return the character position of the given mouse-motion, button-press,\n\
  1381. or button-release event.  If the event did not occur over a window, or did\n\
  1382. not occur over text, then this returns nil.  Otherwise, it returns an index\n\
  1383. into the buffer visible in the event's window.")
  1384.      (event)
  1385.      Lisp_Object event;
  1386. {
  1387.   Bytind bufp;
  1388.   struct window *w;
  1389.  
  1390.   event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0);
  1391.  
  1392.   if (!w)
  1393.     return Qnil;
  1394.   else if (!bufp)
  1395.     return Qnil;
  1396.   else
  1397.     return make_number (bufp);
  1398. }
  1399.  
  1400. DEFUN ("event-closest-point", Fevent_closest_point, Sevent_closest_point,
  1401.        1, 1, 0,
  1402.  "Return the character position of the given mouse-motion, button-press,\n\
  1403. or button-release event.  If the event did not occur over a window or over\n\
  1404. text, return the closest point to the location of the event.  If the Y pixel\n\
  1405. position overlaps a window and the X pixel position is to the left of that\n\
  1406. window, the closest point is the beginning of the line containing the\n\
  1407. Y position.  If the Y pixel position overlaps a window and the X pixel\n\
  1408. position is to the right of that window, the closest point is the end of the\n\
  1409. line containing the Y position.  If the Y pixel position is above a window,\n\
  1410. return 0.  If it is below a window, return the value of (window-end).")
  1411.      (event)
  1412.      Lisp_Object event;
  1413. {
  1414.   Bytind bufp;
  1415.  
  1416.   event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0);
  1417.  
  1418.   if (!bufp)
  1419.     return Qnil;
  1420.   else
  1421.     return make_number (bufp);
  1422. }
  1423.  
  1424. DEFUN ("event-x", Fevent_x, Sevent_x, 1, 1, 0,
  1425.  "Return the X position of the given mouse-motion, button-press, or\n\
  1426. button-release event in characters.  This is relative to the window the\n\
  1427. event occurred over.")
  1428.      (event)
  1429.      Lisp_Object event;
  1430. {
  1431.   int char_x;
  1432.  
  1433.   event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0);
  1434.  
  1435.   return make_number (char_x);
  1436. }
  1437.  
  1438. DEFUN ("event-y", Fevent_y, Sevent_y, 1, 1, 0,
  1439.  "Return the Y position of the given mouse-motion, button-press, or\n\
  1440. button-release event in characters.  This is relative to the window the\n\
  1441. event occurred over.")
  1442.      (event)
  1443.      Lisp_Object event;
  1444. {
  1445.   int char_y;
  1446.  
  1447.   event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0);
  1448.  
  1449.   return make_number (char_y);
  1450. }
  1451.  
  1452.  
  1453. DEFUN ("event-glyph-extent", Fevent_glyph_extent, Sevent_glyph_extent, 1, 1, 0,
  1454.  "If the given mouse-motion, button-press, or button-release event happened\n\
  1455. on top of a glyph, this returns its extent.  Otherwise return nil.")
  1456.      (event)
  1457.      Lisp_Object event;
  1458. {
  1459.   Lisp_Object extent;
  1460.   struct window *w;
  1461.  
  1462.   event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, &extent);
  1463.  
  1464.   if (!w)
  1465.     return Qnil;
  1466.   else if (EXTENTP (extent))
  1467.     return extent;
  1468.   else
  1469.     return Qnil;
  1470. }
  1471.  
  1472. /* You could just as easily use event-glyph-extent but we include this
  1473.    for consistency.  It could easily be implemented in elisp but none
  1474.    of the rest of the event- functions are so we'll just stick it
  1475.    here. */
  1476. DEFUN ("event-over-glyph-p", Fevent_over_glyph_p, Sevent_over_glyph_p,
  1477.        1, 1, 0,
  1478.   "Given a mouse-motion, button-press, or button-release event, return\n\
  1479. t if the event is over a glyph.  Otherwise, return nil.")
  1480.      (event)
  1481.      Lisp_Object event;
  1482. {
  1483.   if (NILP (Fevent_glyph_extent (event)))
  1484.     return Qnil;
  1485.   else
  1486.     return Qt;
  1487. }
  1488.  
  1489. DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, Sevent_glyph_x_pixel,
  1490.        1, 1, 0,
  1491.   "Given a mouse-motion, button-press, or button-release event over a glyph,\n\
  1492. return the X position of the pointer relative to the upper left of the\n\
  1493. glyph.  If the event is not over a glyph, return nil.")
  1494.      (event)
  1495.      Lisp_Object event;
  1496. {
  1497.   Lisp_Object extent;
  1498.   struct window *w;
  1499.   int obj_x;
  1500.  
  1501.   event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, &extent);
  1502.  
  1503.   if (w && EXTENTP (extent))
  1504.     return make_number (obj_x);
  1505.   else
  1506.     return Qnil;
  1507. }
  1508.  
  1509. DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, Sevent_glyph_y_pixel,
  1510.        1, 1, 0,
  1511.   "Given a mouse-motion, button-press, or button-release event over a glyph,\n\
  1512. return the Y position of the pointer relative to the upper left of the\n\
  1513. glyph.  If the event is not over a glyph, return nil.")
  1514.      (event)
  1515.      Lisp_Object event;
  1516. {
  1517.   Lisp_Object extent;
  1518.   struct window *w;
  1519.   int obj_y;
  1520.  
  1521.   event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, &extent);
  1522.  
  1523.   if (w && EXTENTP (extent))
  1524.     return make_number (obj_y);
  1525.   else
  1526.     return Qnil;
  1527. }
  1528.  
  1529. DEFUN ("event-toolbar-button", Fevent_toolbar_button, Sevent_toolbar_button,
  1530.        1, 1, 0,
  1531.   "If the given mouse-motion, button-press, or button-release event happened\n\
  1532. on top of a toolbar button, return the button.  Otherwise, return nil.")
  1533.      (event)
  1534.      Lisp_Object event;
  1535. {
  1536.   Lisp_Object button;
  1537.   int result;
  1538.  
  1539.   result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &button);
  1540.  
  1541.   if (result == OVER_TOOLBAR)
  1542.     {
  1543.       if (TOOLBAR_BUTTONP (button))
  1544.     return button;
  1545.       else
  1546.     return Qnil;
  1547.     }
  1548.   else
  1549.     return Qnil;
  1550. }
  1551.  
  1552. DEFUN ("event-process", Fevent_process, Sevent_process, 1, 1, 0,
  1553.  "Return the process of the given process-output event.")
  1554.      (event)
  1555.   Lisp_Object event;
  1556. {
  1557.   CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
  1558.   return (XEVENT (event)->event.process.process);
  1559. }
  1560.  
  1561. DEFUN ("event-function", Fevent_function, Sevent_function, 1, 1, 0,
  1562.  "Return the callback function of the given timeout, misc-user, or eval event.")
  1563.      (event)
  1564.   Lisp_Object event;
  1565. {
  1566.   CHECK_LIVE_EVENT (event, 0);
  1567.   switch (XEVENT (event)->event_type)
  1568.     {
  1569.     case timeout_event:
  1570.       return (XEVENT (event)->event.timeout.function);
  1571.     case misc_user_event:
  1572.     case eval_event:
  1573.       return (XEVENT (event)->event.eval.function);
  1574.     default:
  1575.       return wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
  1576.     }
  1577. }
  1578.  
  1579. DEFUN ("event-object", Fevent_object, Sevent_object, 1, 1, 0,
  1580.  "Return the callback function argument of the given timeout, misc-user, or\n\
  1581. eval event.")
  1582.      (event)
  1583.   Lisp_Object event;
  1584. {
  1585.  again:
  1586.   CHECK_LIVE_EVENT (event, 0);
  1587.   switch (XEVENT (event)->event_type)
  1588.     {
  1589.     case timeout_event:
  1590.       return (XEVENT (event)->event.timeout.object);
  1591.     case misc_user_event:
  1592.     case eval_event:
  1593.       return (XEVENT (event)->event.eval.object);
  1594.     default:
  1595.       event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
  1596.       goto again;
  1597.     }
  1598. }
  1599.  
  1600.  
  1601. /************************************************************************/
  1602. /*                            initialization                            */
  1603. /************************************************************************/
  1604.  
  1605. void
  1606. syms_of_events (void)
  1607. {
  1608.   defsubr (&Scharacter_to_event);
  1609.   defsubr (&Sevent_to_character);
  1610.  
  1611.   defsubr (&Sallocate_event);
  1612.   defsubr (&Sdeallocate_event);
  1613.   defsubr (&Scopy_event);
  1614.   defsubr (&Seventp);
  1615.   defsubr (&Sevent_live_p);
  1616.   defsubr (&Skey_press_event_p);
  1617.   defsubr (&Sbutton_press_event_p);
  1618.   defsubr (&Sbutton_release_event_p);
  1619.   defsubr (&Sbutton_event_p);
  1620.   defsubr (&Smotion_event_p);
  1621.   defsubr (&Sprocess_event_p);
  1622.   defsubr (&Stimeout_event_p);
  1623.   defsubr (&Smisc_user_event_p);
  1624.   defsubr (&Seval_event_p);
  1625.  
  1626.   defsubr (&Sevent_timestamp);
  1627.   defsubr (&Sevent_key);
  1628.   defsubr (&Sevent_button);
  1629.   defsubr (&Sevent_modifier_bits);
  1630.   defsubr (&Sevent_modifiers);
  1631.   defsubr (&Sevent_x_pixel);
  1632.   defsubr (&Sevent_y_pixel);
  1633.   defsubr (&Sevent_window_x_pixel);
  1634.   defsubr (&Sevent_window_y_pixel);
  1635.   defsubr (&Sevent_over_text_area_p);
  1636.   defsubr (&Sevent_over_modeline_p);
  1637.   defsubr (&Sevent_over_border_p);
  1638.   defsubr (&Sevent_over_toolbar_p);
  1639.   defsubr (&Sevent_device);
  1640.   defsubr (&Sevent_frame);
  1641.   defsubr (&Sevent_window);
  1642.   defsubr (&Sevent_buffer);
  1643.   defsubr (&Sevent_point);
  1644.   defsubr (&Sevent_closest_point);
  1645.   defsubr (&Sevent_x);
  1646.   defsubr (&Sevent_y);
  1647.   defsubr (&Sevent_glyph_extent);
  1648.   defsubr (&Sevent_over_glyph_p);
  1649.   defsubr (&Sevent_glyph_x_pixel);
  1650.   defsubr (&Sevent_glyph_y_pixel);
  1651.   defsubr (&Sevent_toolbar_button);
  1652.   defsubr (&Sevent_process);
  1653.   defsubr (&Sevent_function);
  1654.   defsubr (&Sevent_object);
  1655.  
  1656.   defsymbol (&Qeventp, "eventp");
  1657.   defsymbol (&Qevent_live_p, "event-live-p");
  1658.   defsymbol (&Qkey_press_event_p, "key-press-event-p");
  1659.   defsymbol (&Qbutton_event_p, "button-event-p");
  1660.   defsymbol (&Qmouse_event_p, "mouse-event-p");
  1661.   defsymbol (&Qprocess_event_p, "process-event-p");
  1662. }
  1663.  
  1664. void
  1665. vars_of_events (void)
  1666. {
  1667.   DEFVAR_LISP ("character-set-property", &Vcharacter_set_property,
  1668.    "A symbol used to look up the 8-bit character of a keysym.\n\
  1669. To convert a keysym symbol to an 8-bit code, as when that key is\n\
  1670. bound to self-insert-command, we will look up the property that this\n\
  1671. variable names on the property list of the keysym-symbol.  The window-\n\
  1672. system-specific code will set up appropriate properties and set this\n\
  1673. variable.");
  1674.   Vcharacter_set_property = Qnil;
  1675.  
  1676.   event_resource = 0;
  1677.  
  1678.   QKbackspace = KEYSYM ("backspace");
  1679.   QKtab       = KEYSYM ("tab");
  1680.   QKlinefeed  = KEYSYM ("linefeed");
  1681.   QKreturn    = KEYSYM ("return");
  1682.   QKescape    = KEYSYM ("escape");
  1683.   QKspace     = KEYSYM ("space");
  1684.   QKdelete    = KEYSYM ("delete");
  1685.   QKnosymbol  = KEYSYM ("NoSymbol");
  1686.  
  1687.   staticpro (&QKbackspace);
  1688.   staticpro (&QKtab);
  1689.   staticpro (&QKlinefeed);
  1690.   staticpro (&QKreturn);
  1691.   staticpro (&QKescape);
  1692.   staticpro (&QKspace);
  1693.   staticpro (&QKdelete);
  1694.   staticpro (&QKnosymbol);
  1695. }
  1696.